home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Collection of Tools & Utilities
/
Collection of Tools and Utilities.iso
/
bbsutil
/
dlx70bbs.zip
/
DLX70SRC.ZIP
/
PMSTATS.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1994-02-08
|
12KB
|
405 lines
{$debug+}
{$line+}
{$include: 'types.int'}
{$include: 'globals.int'}
program PMSTATS(input,output);
{
Pubmail Statistics Program for DLX
Richard Gillmann, February 1993
To Build: pl /c pmstats.pas
link pmstats+globals,,,/NOD/EXEPACK libpasa;
}
{DLX Bulletin Board System V7.0
FREEWARE NOTICE
DLX V7.0 is placed in the public domain by its author, Richard Gillmann.
Anyone who wishes to may run the program, copy it, or modify it for
any purpose, including commercial gain.}
USES types,globals;
{***Special for calling file initialize module***}
procedure globals; EXTERN;
{***Interface to MS Pascal library***}
procedure date(var s : string); EXTERN;
function getmqq(wants : word) : adsmem; EXTERN;
const
max_members = 4400;
tab = chr(9);
type
member_info_record = record
handle : lstring(5);
user_level : char;
sex : char;
sexpref : char;
married : char;
age : integer;
posts : integer;
end {member_index_record};
member_info_array = array [1..max_members] of member_info_record;
ads_mif = ads of member_info_array;
{strip trailing blanks and comments}
procedure stripc(var str : lstring);
var
i : integer;
begin
for i:=1 to ord(str.len) do
if str[i]=chr(0) or else str[i]='{' then
[str.len:=wrd(i-1); break];
for i:=ord(str.len) downto 1 do
if str[i]=' ' or else str[i]=tab then str.len:=str.len-1 else break;
end {stripc};
function date2jd(consts dd : string) : integer4;
var
c,ya : integer4;
month,day,year,temp : integer;
w : word;
begin
{get raw date}
month:=(ord(dd[1])-ord('0'))*10 + (ord(dd[2])-ord('0'));
day :=(ord(dd[4])-ord('0'))*10 + (ord(dd[5])-ord('0'));
year :=(ord(dd[7])-ord('0'))*10 + (ord(dd[8])-ord('0'));
{process}
if year>=80
then year:=year+1900
else year:=year+2000;
if month > 2 then
month := month - 3
else begin
month := month + 9; year := year - 1;
end {else};
c := year div 100;
ya := year mod 100;
date2jd := ((146097*c) div 4) + ((1461*ya) div 4) +
((153*month + 2) div 5) + day + 1721119;
end {date2jd};
function r(x : real) : integer;
begin
r := trunc(x+0.5);
end;
var
lstr : lstring(255);
BoardName : array [1..50] of lstring(24);
BoardInfo : array [1..50,1..12] of integer;
bb : integer; {number of pubs}
ll : integer; {top "n" (10 if lots)}
procedure SortLemma(k : integer);
var
i,j,Temp,l : integer;
begin
for i:=1 to bb do
for j:=i+1 to bb do
if BoardInfo[i][k] < BoardInfo[j][k] then
[copylst(BoardName[i],lstr);
copylst(BoardName[j],BoardName[i]);
copylst(lstr,BoardName[j]);
for l:=1 to 12 do
[Temp:=BoardInfo[i][l];
BoardInfo[i][l]:=BoardInfo[j][l];
BoardInfo[j][l]:=Temp]];
end {SortLemma};
procedure SortBy(k : integer);
var
i : integer;
begin
SortLemma(k);
for i:=1 to ll do
writeln(BoardInfo[i][k]:4,' ',BoardName[i]:-24,' ',
BoardInfo[bb-i+1][k]:4,' ',BoardName[bb-i+1]:-24);
writeln;
end {SortBy};
var
when,now : lstring(8);
jdWhen,jdNow,jdOldest : integer4;
member_info : ads_mif;
i,n : integer;
pm : pubmail_record;
nMsgs,nLastMonth,nValid : integer;
nPosters,nSub,nMen,nStr,nSgl : integer;
SubTotal, TotalAge : integer4;
nTopPosts, nTopPoster : integer;
nTop2Posts, nTop2Poster : integer;
begin
{open members and pubmail files}
globals;{pascal file system}
assign(f_members,'members');
reset(f_members);
assign(f_pubmail,'pubmail');
reset(f_pubmail);
{print herald}
writeln('Public Mail Statistics');
now.len:=8; date(now);
jdNow:=date2jd(now);
now[3]:='/'; now[6]:='/';
writeln(now:8);
writeln;
{malloc memory}
mbi:=sizeof(member_info^[1])*max_members;
member_info:=getmqq(mbi);
{read the members file}
n:=0;
while not eof(f_members) and then n<max_members do begin
readln(f_members,member_internal_buffer);
n:=n+1;
movel(adr member_internal_buffer,adr member_buffer,member_length);
member_info^[n].handle.len:=5;
for i:=1 to 5 do
member_info^[n].handle[i]:=member_buffer.name[i];
member_info^[n].user_level:=member_buffer.userlevel[1];
member_info^[n].sex:=member_buffer.gender[1];
member_info^[n].sexpref:=member_buffer.pref[1];
member_info^[n].married:=member_buffer.mult_answer[1][4];
lstr.len:=3;
for i:=1 to 3 do
lstr[i]:=member_buffer.age[i];
eval(decode(lstr,i));
member_info^[n].age:=i;
member_info^[n].posts:=0;
end {while};
close(f_members);
{print the table headings}
writeln(' # Msg Last Post % % % % % Avg');
writeln('C Board Title Msg /Mo Mnth -ers Mod Sub Men Str Sgl Age Top Posters');
writeln('- ----------- --- --- ---- ---- --- --- --- --- --- --- -----------');
{read the pubmail file}
bb:=0;
while not eof(f_pubmail) do begin
{get title, letter, mod#}
readln(f_pubmail,lstr); stripc(lstr);
if lstr.len>24 then lstr.len:=24;
copystr(lstr,pm.name);
bb:=bb+1;
copylst(lstr,BoardName[bb]);
readln(f_pubmail,pm.letter);
readln(f_pubmail,pm.memberid);
if pm.memberid>n then
pm.memberid:=0;
readln(f_pubmail);
readln(f_pubmail);
readln(f_pubmail);
readln(f_pubmail,pm.anon);
readln(f_pubmail);
readln(f_pubmail);
readln(f_pubmail);
readln(f_pubmail);
readln(f_pubmail);
readln(f_pubmail);
readln(f_pubmail);
if not eof(f_pubmail) then
readln(f_pubmail,lstr);
{for each category}
nMsgs:=0; nValid:=0;
nLastMonth:=0;
jdOldest:=0;
{clear posts counters}
for i:=1 to n do
member_info^[i].posts:=0;
{read the index file}
copylst('PUB-BOX\INDEX',lstr); concat(lstr,pm.letter);
f_index.trap:=true; f_index.errs:=0;
assign(f_index,lstr); reset(f_index);
while (f_index.errs=0) and then (not eof(f_index)) do begin
readln(f_index,index_internal_buffer);
movel(adr index_internal_buffer,adr index_buffer,index_length);
{find out who posted each message}
copylst(index_buffer.msg_from,lstr);
for i:=ord(lstr.len) downto 1 do
if lstr[i]=' '
then lstr.len:=wrd(i-1)
else break;
while lstr[1]<'0' or else lstr[1]>'9' do
delete(lstr,1,1);
eval(decode(lstr,i));
{total posts/caller, #msgs, #msgs last month, oldest msg}
if i>4 and then i<=n then begin
member_info^[i].posts:=member_info^[i].posts+1;
nMsgs:=nMsgs+1;
for i:=1 to 8 do
when[i]:=index_buffer.date[i];
when.len:=8;
jdWhen:=date2jd(when);
if jdOldest=0 then
jdOldest:=jdWhen;
if (jdWhen+30) >= jdNow then
nLastMonth:=nLastMonth+1;
end {if};
end {while};
close(f_index);
{go thru member array, compute stats}
nPosters:=0;
nSub:=0;
nMen:=0;
nStr:=0;
nSgl:=0;
TotalAge:=0;
nTopPosts:=0;
nTopPoster:=0;
nTop2Posts:=0;
nTop2Poster:=0;
for i:=5 to n do if member_info^[i].posts>0 then begin
nValid:=nValid+member_info^[i].posts;
nPosters:=nPosters+1;
if member_info^[i].user_level>'3' then
nSub:=nSub+member_info^[i].posts;
if member_info^[i].sex='M' then
nMen:=nMen+member_info^[i].posts;
if member_info^[i].sexpref='S' then
nStr:=nStr+member_info^[i].posts;
if member_info^[i].married='S' then
nSgl:=nSgl+member_info^[i].posts;
SubTotal := member_info^[i].posts;
SubTotal := SubTotal * member_info^[i].age;
TotalAge := TotalAge + SubTotal;
if pm.memberid<>i then begin
if member_info^[i].posts>nTopPosts then
[nTop2Posts:=nTopPosts;
nTop2Poster:=nTopPoster;
nTopPosts:=member_info^[i].posts;
nTopPoster:=i]
else if member_info^[i].posts>nTop2Posts then
[nTop2Posts:=member_info^[i].posts;
nTop2Poster:=i];
end {if not moderator};
end {for if};
{print line of stats}
for i:=1 to 12 do BoardInfo[bb][i]:=0;
write(pm.letter:-2);
write(pm